home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / ASSTUFF next >
Text File  |  1990-02-23  |  8KB  |  419 lines
  1. /* asstuff.c - Amiga specific routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. #ifndef MANX
  6. #define agetc getc    /* Not sure if this will work in all cases (fnf) */
  7. #define aputc putc    /* Not sure if this will work in all cases (fnf) */
  8. #endif
  9.  
  10. #define LBSIZE 200
  11.  
  12. /* external routines */
  13. extern double ran();
  14.  
  15. /* external variables */
  16. extern NODE *s_unbound,*true;
  17. extern int prompt;
  18. extern int errno;
  19.  
  20. /* line buffer variables */
  21. static char lbuf[LBSIZE];
  22. static int  lpos[LBSIZE];
  23. static int lindex;
  24. static int lcount;
  25. static int lposition;
  26.  
  27. #define NEW 1006
  28. static long xlispwindow;
  29.  
  30. /* osinit - initialize */
  31. osinit(banner)
  32.   char *banner;
  33. {
  34.     extern int Enable_Abort;
  35.  
  36.     Enable_Abort = 0;        /* Turn off ~C interrupt in case it's on */
  37.     xlispwindow = Open("RAW:1/1/639/199/Xlisp by David Betz", NEW);
  38.     while (*banner != '\000') {
  39.     xputc (*banner++);
  40.     }
  41.     xputc ('\n');
  42.     lposition = 0;
  43.     lindex = 0;
  44.     lcount = 0;
  45. }
  46.  
  47. osfinish ()
  48. {
  49.     Close (xlispwindow);
  50. }
  51.  
  52. /* osrand - return a random number between 0 and n-1 */
  53. int osrand(n)
  54.   int n;
  55. {
  56.     n = (int)(ran() * (double)n);
  57.     return (n < 0 ? -n : n);
  58. }
  59.  
  60. /* osgetc - get a character from the terminal */
  61. int osgetc(fp)
  62.   FILE *fp;
  63. {
  64.     int ch;
  65.  
  66.     /* check for input from a file other than stdin */
  67.     if (fp != stdin)
  68.     return ((int)agetc(fp));
  69.  
  70.     /* check for a buffered character */
  71.     if (lcount--)
  72.     return ((int)lbuf[lindex++]);
  73.  
  74.     /* get an input line */
  75.     for (lcount = 0; ; )
  76.     switch (ch = xgetc()) {
  77.     case '\n':
  78.     case '\r':
  79.         lbuf[lcount++] = '\n';
  80.         xputc('\r'); xputc('\n'); lposition = 0;
  81.         lindex = 0; lcount--;
  82.         return ((int)lbuf[lindex++]);
  83.     case '\010':
  84.     case '\177':
  85.         if (lcount) {
  86.             lcount--;
  87.             while (lposition > lpos[lcount]) {
  88.             xputc('\010'); xputc(' '); xputc('\010');
  89.             lposition--;
  90.             }
  91.         }
  92.         break;
  93.     case '\032':
  94.         osflush();
  95.         return (EOF);
  96.     default:
  97.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  98.             lbuf[lcount] = ch;
  99.             lpos[lcount] = lposition;
  100.             if (ch == '\t')
  101.             do {
  102.                 xputc(' ');
  103.             } while (++lposition & 7);
  104.             else {
  105.             xputc(ch); lposition++;
  106.             }
  107.             lcount++;
  108.         }
  109.         else {
  110.             osflush();
  111.             switch (ch) {
  112.             case '\003':    xltoplevel();    /* control-c */
  113.             case '\007':    xlcleanup();    /* control-g */
  114.             case '\020':    xlcontinue();    /* control-p */
  115.             case '\032':    return (EOF);    /* control-z */
  116.             default:        return (ch);
  117.             }
  118.         }
  119.     }
  120. }
  121.  
  122. /* osputc - put a character to the terminal */
  123. osputc(ch,fp)
  124.   int ch; FILE *fp;
  125. {
  126.     /* check for output to something other than stdout */
  127.     if (fp != stdout)
  128.     return (aputc(ch,fp));
  129.  
  130.     /* check for control characters */
  131.     oscheck();
  132.  
  133.     /* output the character */
  134.     if (ch == '\n') {
  135.     xputc('\r'); xputc('\n');
  136.     lposition = 0;
  137.     }
  138.     else {
  139.     xputc(ch);
  140.     lposition++;
  141.    }
  142. }
  143.  
  144. /* oscheck - check for control characters during execution */
  145. oscheck()
  146. {
  147.     int ch;
  148.     if (ch = xcheck())
  149.     switch (ch) {
  150.     case '\002':    osflush(); xlbreak("BREAK",s_unbound); break;
  151.     case '\003':    osflush(); xltoplevel(); break;
  152.     }
  153. }
  154.  
  155. /* osflush - flush the input line buffer */
  156. osflush()
  157. {
  158.     lindex = lcount = 0;
  159.     osputc('\n',stdout);
  160.     prompt = 1;
  161. }
  162.  
  163. /* xgetc - get a character from the terminal without echo */
  164. static int xgetc()
  165. {
  166.     char ch;
  167.  
  168.     Read (xlispwindow, &ch, 1);
  169.     return (ch & 0xFF);
  170. }
  171.  
  172. /* xputc - put a character to the terminal */
  173. static xputc(ch)
  174.   int ch;
  175. {
  176.     char chout;
  177.  
  178.     chout = ch;
  179.     Write (xlispwindow, &chout, 1L);
  180. }
  181.  
  182. /* xcheck - check for a character */
  183. static int xcheck()
  184. {
  185.     if (WaitForChar (xlispwindow, 0L) == 0L)
  186.     return (0);
  187.     return (xgetc() & 0xFF);
  188. }
  189.  
  190. /* xdos - execute a dos command */
  191. NODE *xdos(args)
  192.   NODE *args;
  193. {
  194.     char *cmd;
  195.     cmd = xlmatch(STR,&args)->n_str;
  196.     xllastarg(args);
  197.     return (system(cmd) == -1 ? cvfixnum((FIXNUM)errno) : true);
  198. }
  199.  
  200. int system (cmd)
  201. char *cmd;
  202. {
  203.     return (Execute(cmd, 0L, xlispwindow));
  204. }
  205.  
  206. double ran ()    /* Just punt for now, not in Manx C; FIXME!!*/
  207. {
  208.     static long seed = 654321;
  209.     long lval;
  210.     double dval;
  211.  
  212.     seed *= ((8 * (123456) - 3));
  213.     lval = seed & 0xFFFF;
  214.     dval = ((double) lval) / ((double) (0x10000));
  215.     return (dval);
  216. }
  217.     
  218. /* xgetkey - get a key from the keyboard */
  219. NODE *xgetkey(args)
  220.   NODE *args;
  221. {
  222.     xllastarg(args);
  223.     return (cvfixnum((FIXNUM)xgetc()));
  224. }
  225.  
  226. #ifdef DEADCODE    /* Dont' use this for now?  (fnf) */
  227.  
  228. /* xcursor - set the cursor position */
  229. NODE *xcursor(args)
  230.   NODE *args;
  231. {
  232.     int row,col;
  233.     row = xlmatch(INT,&args)->n_int;
  234.     col = xlmatch(INT,&args)->n_int;
  235.     xllastarg(args);
  236.     scr_curs(row,col);
  237.     return (NIL);
  238. }
  239.  
  240. /* xclear - clear the screen */
  241. NODE *xclear(args)
  242.   NODE *args;
  243. {
  244.     xllastarg(args);
  245.     scr_clear();
  246.     return (NIL);
  247. }
  248.  
  249. /* xeol - clear to end of line */
  250. NODE *xeol(args)
  251.   NODE *args;
  252. {
  253.     xllastarg(args);
  254.     scr_eol();
  255.     return (NIL);
  256. }
  257.  
  258.  
  259. /* xeos - clear to end of screen */
  260. NODE *xeos(args)
  261.   NODE *args;
  262. {
  263.     xllastarg(args);
  264.     scr_eos();
  265.     return (NIL);
  266. }
  267.  
  268. /* xlinsert - insert line */
  269. NODE *xlinsert(args)
  270.   NODE *args;
  271. {
  272.     xllastarg(args);
  273.     scr_linsert();
  274.     return (NIL);
  275. }
  276.  
  277. /* xldelete - delete line */
  278. NODE *xldelete(args)
  279.   NODE *args;
  280. {
  281.     xllastarg(args);
  282.     scr_ldelete();
  283.     return (NIL);
  284. }
  285.  
  286. /* xcinsert - insert character */
  287. NODE *xcinsert(args)
  288.   NODE *args;
  289. {
  290.     xllastarg(args);
  291.     scr_cinsert();
  292.     return (NIL);
  293. }
  294.  
  295. /* xcdelete - delete character */
  296. NODE *xcdelete(args)
  297.   NODE *args;
  298. {
  299.     xllastarg(args);
  300.     scr_cdelete();
  301.     return (NIL);
  302. }
  303.  
  304. /* xinverse - set/clear inverse video */
  305. NODE *xinverse(args)
  306.   NODE *args;
  307. {
  308.     NODE *val;
  309.     val = xlarg(&args);
  310.     xllastarg(args);
  311.     scr_invers(val ? 1 : 0);
  312.     return (NIL);
  313. }
  314.  
  315. /* xline - draw a line */
  316. NODE *xline(args)
  317.   NODE *args;
  318. {
  319.     int x1,y1,x2,y2;
  320.     x1 = xlmatch(INT,&args)->n_int;
  321.     y1 = xlmatch(INT,&args)->n_int;
  322.     x2 = xlmatch(INT,&args)->n_int;
  323.     y2 = xlmatch(INT,&args)->n_int;
  324.     xllastarg(args);
  325.     line(x1,y1,x2,y2);
  326.     return (NIL);
  327. }
  328.  
  329. /* xpoint - draw a point */
  330. NODE *xpoint(args)
  331.   NODE *args;
  332. {
  333.     int x,y;
  334.     x = xlmatch(INT,&args)->n_int;
  335.     y = xlmatch(INT,&args)->n_int;
  336.     xllastarg(args);
  337.     point(x,y);
  338.     return (NIL);
  339. }
  340.  
  341. /* xcircle - draw a circle */
  342. NODE *xcircle(args)
  343.   NODE *args;
  344. {
  345.     int x,y,r;
  346.     x = xlmatch(INT,&args)->n_int;
  347.     y = xlmatch(INT,&args)->n_int;
  348.     r = xlmatch(INT,&args)->n_int;
  349.     xllastarg(args);
  350.     circle(x,y,r);
  351.     return (NIL);
  352. }
  353.  
  354. /* xaspect - set the aspect ratio */
  355. NODE *xaspect(args)
  356.   NODE *args;
  357. {
  358.     int x,y;
  359.     x = xlmatch(INT,&args)->n_int;
  360.     y = xlmatch(INT,&args)->n_int;
  361.     xllastarg(args);
  362.     set_asp(x,y);
  363.     return (NIL);
  364. }
  365.  
  366. /* xcolors - setup the display colors */
  367. NODE *xcolors(args)
  368.   NODE *args;
  369. {
  370.     int c,p,b;
  371.     c = xlmatch(INT,&args)->n_int;
  372.     p = xlmatch(INT,&args)->n_int;
  373.     b = xlmatch(INT,&args)->n_int;
  374.     xllastarg(args);
  375.     color(c);
  376.     palette(p);
  377.     ground(b);
  378.     return (NIL);
  379. }
  380.  
  381. /* xmode - set the display mode */
  382. NODE *xmode(args)
  383.   NODE *args;
  384. {
  385.     int m;
  386.     m = xlmatch(INT,&args)->n_int;
  387.     xllastarg(args);
  388.     mode(m);
  389.     return (NIL);
  390. }
  391.  
  392. #endif DEADCODE
  393.  
  394. /* osfinit - initialize pc specific functions */
  395. osfinit()
  396. {
  397.     xlsubr("DOS",        SUBR,    xdos);
  398.     xlsubr("GET-KEY",        SUBR,    xgetkey);
  399. #ifdef DEADCODE
  400.     xlsubr("SET-CURSOR",    SUBR,    xcursor);
  401.     xlsubr("CLEAR",        SUBR,    xclear);
  402.     xlsubr("CLEAR-EOL",        SUBR,    xeol);
  403.     xlsubr("CLEAR-EOS",        SUBR,    xeos);
  404.     xlsubr("INSERT-LINE",    SUBR,    xlinsert);
  405.     xlsubr("DELETE-LINE",    SUBR,    xldelete);
  406.     xlsubr("INSERT-CHAR",    SUBR,    xcinsert);
  407.     xlsubr("DELETE-CHAR",    SUBR,    xcdelete);
  408.     xlsubr("SET-INVERSE",    SUBR,    xinverse);
  409.     xlsubr("LINE",         SUBR,    xline);
  410.     xlsubr("POINT",        SUBR,    xpoint);
  411.     xlsubr("CIRCLE",        SUBR,    xcircle);
  412.     xlsubr("ASPECT-RATIO",    SUBR,    xaspect);
  413.     xlsubr("COLORS",        SUBR,    xcolors);
  414.     xlsubr("MODE",         SUBR,    xmode);
  415. #endif DEADCODE
  416. }
  417.  
  418.  
  419.